### Paper: Sex Crime and Punishment in the #MeToo Era 
### Authors: Susanne Schwarz, Dara Kay Cohen, Matthew Baum 
### Code: Helper Functions 

# Function to Get Labels for Predicted Case Profiles 

getlabels <- function(vector){
  
  label <- c("")
  for(i in 1:length(vector)){
    
    if(i==1){ # VIC_SEX
      if(vector[i]=="Male"){lab <- c("Male")}
      if(vector[i]=="Female"){lab <- c("Female")}
      lab <- paste("Victim sex: ",lab,sep="")
      label = paste(label,lab,sep="")
    }
    
    if(i==2){ # VIC_ETHN
      if(vector[i]=="Victim White"){lab <- c("White")}
      if(vector[i]=="Victim Black"){lab <- c("Black")}
      lab <- paste("Victim Race: ",lab,sep="")
      label = paste(label,lab,sep="; ")
    }
    
    if(i==3){ # VIC_CRIMINAL
      if(vector[i]=="No criminal record"){lab <- c("No criminal record")}
      if(vector[i]=="Minor felony record"){lab <- c("Minor felony record")}
      lab <- paste("Victim Criminal Record: ",lab,sep="")
      label = paste(label,lab,sep="; ")
    }
    
    if(i==4){ # VIC_MARITAL
      if(vector[i]=="Married"){lab <- c("Married")}
      if(vector[i]=="Single"){lab <- c("Single")}
      if(vector[i]=="Multiple Partners"){lab <- c("Multiple Partners")}
      lab <- paste("Victim Marital Status: ",lab,sep="")
      label = paste(label,lab,sep="; ")
    }    
    
    if(i==5){ # PERP_ETHN
      if(vector[i]=="Perpetrator White"){lab <- c("White")}
      if(vector[i]=="Perpetrator Black"){lab <- c("Black")}
      lab <- paste("Perpetrator Race: ",lab,sep="")
      label = paste(label,lab,sep="; ")
    }
    
    if(i==6){ # PERP_PROF
      if(vector[i]=="Worker"){lab <- c("Construction Worker")}
      if(vector[i]=="Athlete"){lab <- c("Athlete")}
      if(vector[i]=="Business man"){lab <- c("Business man")}
      lab <- paste("Perpetrator Profession: ",lab,sep="")
      label = paste(label,lab,sep="; ")
    }
    
    if(i==7){ # PERP_RELATION
      if(vector[i]=="Stranger"){lab <- c("Stranger")}
      if(vector[i]=="Acquaintance"){lab <- c("Acquaintance")}
      lab <- paste("Victim-Perpetrator Relationship: ",lab,sep="")
      label = paste(label,lab,sep="; ")
    }
    if(i==8){ # LOCATION
      if(vector[i]=="Park"){lab <- c("Park")}
      if(vector[i]=="Party"){lab <- c("Party")}
      if(vector[i]=="Home"){lab <- c("Home of Victim")}
      lab <- paste("Incident location: ",lab,sep="")
      label = paste(label,lab,sep="; ")
    }
    if(i==9){ # VICTIM ATTIRE
      if(vector[i]=="Work Attire"){lab <- c("Work Attire")}
      if(vector[i]=="Night Club Attire"){lab <- c("Night Club Attire")}
      lab <- paste("Outfit at the time of incident: ",lab,sep="")
      label = paste(label,lab,sep="; ")
    }
    
  }
  return(label) 
}



##FUNCTION FOR ICR STATS

icrFun <- function(X,Coders=NULL,keepz=NULL,stripz=NULL,varz=NULL,nboot=100,rnd=2,print=TRUE){
  
  # Coders
  if(length(Coders)==0){Coders <- sort(unique(X$Coder))}
  
  # Strip
  if(length(stripz)>0){
    if(length(stripz)==1){X <- X[X[,stripz]==0,]}
    if(length(stripz)>1){X <- X[apply(X[,stripz],1,sum)==0,]}
  }
  
  # Keep
  if(length(keepz)>0){
    if(length(keepz)==1){X <- X[X[,keepz]>0,]}
    if(length(keepz)>1){X <- X[apply(X[,keepz],1,sum)>0,]}
  }
  
  # Variables
  if(length(varz)==0){varz <- names(X)[!names(X)%in%c("AID","Coder")]}
  
  # Keep only common documents
  list.X <- lapply(1:length(Coders),function(i){sub.X <- X[X$Coder==Coders[i],];sub.X})
  list.IDs <- lapply(1:length(Coders),function(i){list.X[[i]][,"AID"]})
  list.IDs <- Reduce(intersect,list.IDs, accumulate = F)
  list.X <- lapply(1:length(Coders),function(i){sub.X <- list.X[[i]][which(list.X[[i]][,"AID"]%in%list.IDs),]; sub.X <- sub.X[order(sub.X[,"AID"]),]; sub.X})
  
  
  # Create holder matrix  
  mat <- as.data.frame(matrix(NA,nrow=length(varz), ncol=10))
  rownames(mat) <- varz
  names(mat) <- c("All Agree","Kappa","K p value","Kendall's W","W p value","Kripp A","A SE","A CI Low","A CI High","N")
  
  for(j in 1:length(varz)){
    if(print==TRUE){print(varz[j])}
    
    X.var <- lapply(1:length(Coders),function(i){sub.X <- list.X[[i]][,varz[j]];sub.X});X.var <- do.call(cbind,X.var)
    
    # All agree
    mat[j,1] <- round(agree(X.var)$value,rnd)
    
    # Fleiss' Kappa
    k <- kappam.fleiss(X.var)
    mat[j,2] <- round(k$value,rnd)
    mat[j,3] <- round(k$p.value,rnd)
    
    # Kendall's W
    k <- kendall(X.var,correct=T)
    mat[j,4] <- round(k$value,rnd)
    mat[j,5] <- round(k$p.value,rnd)
    
    # Krippendorf's Alpha
    alphas <- c()
    for(k in 1:nboot){
      rows <- sample(1:nrow(X.var),100,replace=T)
      alphas[k] <- kripp.alpha(t(X.var[rows,]),method="interval")$value}
    mat[j,6] <- round(mean(alphas,na.rm=T),rnd)
    mat[j,7] <- round(sqrt(var(alphas)),rnd)
    mat[j,8] <- round(quantile(alphas,.025),rnd)
    mat[j,9] <- round(quantile(alphas,.975),rnd)
    
    # N
    mat[j,10] <- nrow(X.var)
  }
  
  
  return(mat)
}